perm filename EVAL.LSP[F77,JMC] blob
sn#322580 filedate 1977-12-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (defun bind←identifiers (identifiers values environment expression)
C00010 ENDMK
C⊗;
(defun bind←identifiers (identifiers values environment expression)
(cond ((null identifiers)
(cond ((null values)
environment)
(t (error '|Too Few Arguments| expression))))
((null values)
(error '|Too Many Arguments| expression))
(t (cons (list (car identifiers) (car values))
(bind←identifiers (cdr identifiers)
(cdr values)
environment
expression)))))
(defun lookup (identifier environment)
(cond ((null environment)
(error '|Unbound Variable| identifier))
((equal identifier (caar environment))
(cadar environment))
(t (lookup identifier (cdr environment)))))
(defun list←of←values (expressions environment)
(cond ((null expressions)
nil)
(t (cons (heval (car expressions) environment)
(list←of←values (cdr expressions) environment)))))
(defun heval←list (current←value expressions environment)
(cond ((null expressions)
current←value)
(t (heval←list (heval (car expressions) environment)
(cdr expressions)
environment))))
(defun heval (expression environment)
(cond ((atom expression)
(cond ((numberp expression)
expression)
(t (lookup expression environment))))
((eq (car expression) 'quote)
(cadr expression))
((eq (car expression) 'lambda)
expression)
((eq (car expression) 'cond)
(heval←cond←clauses (cdr expression) environment))
(t (happly (heval (car expression) environment)
(list←of←values (cdr expression) environment)
expression
environment))))
(defun happly (procedure arguments expression environment)
(cond ((primitive? procedure)
(happly←primitive procedure arguments))
((eq (car procedure) 'lambda)
(heval←list (heval (caddr procedure)
(bind←identifiers (cadr procedure) environment expression))
(cdddr procedure)
(bind←identifiers (cadr procedure) environment expression)))
(t (error '|Unknown Procedure| (list procedure arguments)))))
(defun heval←cond←clauses (clauses environment)
(cond ((null clauses)
nil)
((heval (caar clauses) environment)
(heval←list 't (cdr clauses) environment))
(t (heval←cond←clauses (cdr clauses) environment))))